home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / lang / elisp / primitives / match.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  1.9 KB  |  69 lines
  1. (define-module (lang elisp primitives match)
  2.   #:use-module (lang elisp internals fset)
  3.   #:use-module (ice-9 regex)
  4.   #:use-module (ice-9 optargs))
  5.  
  6. (define last-match #f)
  7.  
  8. (fset 'string-match
  9.       (lambda (regexp string . start)
  10.  
  11.     (define emacs-string-match
  12.  
  13.       (if (defined? 'make-emacs-regexp)
  14.  
  15.           ;; This is what we would do if we had an
  16.           ;; Emacs-compatible regexp primitive, here called
  17.           ;; `make-emacs-regexp'.
  18.           (lambda (pattern str . args)
  19.         (let ((rx (make-emacs-regexp pattern))
  20.               (start (if (pair? args) (car args) 0)))
  21.           (regexp-exec rx str start)))
  22.  
  23.           ;; But we don't have Emacs-compatible regexps, and I
  24.           ;; don't think it's worthwhile at this stage to write
  25.           ;; generic regexp conversion code.  So work around the
  26.           ;; discrepancies between Guile/libc and Emacs regexps by
  27.           ;; substituting the regexps that actually occur in the
  28.           ;; elisp code that we want to read.
  29.           (lambda (pattern str . args)
  30.         (let loop ((discrepancies '(("^[0-9]+\\.\\([0-9]+\\)" .
  31.                          "^[0-9]+\\.([0-9]+)"))))
  32.           (or (null? discrepancies)
  33.               (if (string=? pattern (caar discrepancies))
  34.               (set! pattern (cdar discrepancies))
  35.               (loop (cdr discrepancies)))))
  36.         (apply string-match pattern str args))))
  37.  
  38.     (let ((match (apply emacs-string-match regexp string start)))
  39.       (set! last-match
  40.         (if match
  41.             (apply append!
  42.                (map (lambda (n)
  43.                   (list (match:start match n)
  44.                     (match:end match n)))
  45.                 (iota (match:count match))))
  46.             #f)))
  47.  
  48.     (if last-match (car last-match) %nil)))
  49.  
  50. (fset 'match-beginning
  51.       (lambda (subexp)
  52.     (list-ref last-match (* 2 subexp))))
  53.  
  54. (fset 'match-end
  55.       (lambda (subexp)
  56.     (list-ref last-match (+ (* 2 subexp) 1))))
  57.  
  58. (fset 'substring substring)
  59.  
  60. (fset 'match-data
  61.       (lambda* (#:optional integers reuse)
  62.     last-match))
  63.  
  64. (fset 'set-match-data
  65.       (lambda (list)
  66.     (set! last-match list)))
  67.  
  68. (fset 'store-match-data 'set-match-data)
  69.